#lang racket


(require "../constructors.rkt"
         "../point.rkt"
         "../point-matrix.rkt")

(require "segment.rkt"
         "parametric-surface.rkt")


(provide (struct-out unsupported)
         (struct-out patch)
         
         u-strategy-min
         u-strategy-half
         u-strategy-max
         
         v-strategy-min
         v-strategy-half
         v-strategy-max
         
         patch-object
         patch-tangent
         patch-normal
         patch-cs)


(define (patch-print patch port mode)
  (write-string "patch(" port)
  (write-string (format "~a" (patch-domain-u patch)) port)
  (write-string " " port)
  (write-string (format "~a" (patch-domain-v patch)) port)
  (write-string ")" port))

(define-struct patch
  (parametric domain-u domain-v)
  #:property prop:custom-write patch-print)


(define u-strategy-min t-strategy-min)
(define u-strategy-half t-strategy-half)
(define u-strategy-max t-strategy-max)

(define v-strategy-min t-strategy-min)
(define v-strategy-half t-strategy-half)
(define v-strategy-max t-strategy-max)

(define (matrix*points matrix points vector?)
  (if (point? points)
      (m*p matrix points vector?)
      (map (λ (p) (m*p matrix p vector?)) points)))

(define (patch-space patch space u-strategy v-strategy vector?)
  (let ((parametric (patch-parametric patch))
        (u (u-strategy (patch-domain-u patch)))
        (v (v-strategy (patch-domain-v patch))))
    (matrix*points 
     (parametric-surface-transformation parametric)
     ((space parametric) u v)
     vector?)))

(define (patch-object patch (u-strategy (u-strategy-min)) (v-strategy (v-strategy-min)))
  (patch-space patch parametric-surface-object u-strategy v-strategy #f))

(define (patch-tangent patch (u-strategy (u-strategy-min)) (v-strategy (v-strategy-min)))
  (patch-space patch parametric-surface-tangent u-strategy v-strategy #t))

(define (patch-normal patch (u-strategy (u-strategy-min)) (v-strategy (v-strategy-min)))
  (patch-space patch parametric-surface-normal u-strategy v-strategy #t))

(define (patch-cs patch node (u-strategy (u-strategy-min)) (v-strategy (v-strategy-min)))
  (move
   (patch-object patch u-strategy v-strategy)
   (rotate
    (p<\p uz (patch-normal patch u-strategy v-strategy))
    (pxp uz (patch-normal patch u-strategy v-strategy))
    node)))